perm filename XX[1,LCS]1 blob
sn#079053 filedate 1974-01-08 generic text, type T, neo UTF8
00100 C ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200 C *** READS DATA FROM CLFX, TAIL, FERM, BREP, REST, DRAW1, DRAW2
00300
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00600 COMMON /DL/X22,SAVER,NAME/RRJJ/RJJ(20)
00700 DIMENSION RPOS(2,40),LST(13),DP(-3/4),LX(14),LY(7),R(8,100)
00800 COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
00900 COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01000 COMMON/ALF/INP(72),ML/XRN/RN(4000)/STF/RSTFAC(8),RSTJC
01100 COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/POSI/STFF(8),JJB,POS
01300 COMMON/DPY/ST(4000),WDS(250),MEDIT,GO
01400 EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
01500 1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
01600 1,(JK,JQ(9)),(JF,JQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2)),(IT,LY(7))
01700 1,(RJC,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(RXGP,WDS(250))
01710 1,(RJK,RJQ(9)),(RJQJ,RJQ(8)),(SET4,RN(3920)),(R,RN(3001))
01800 1 ,(TOP,ST(3999)),(BOT,ST(4000)),(RJH,RJQ(6)),(RJI,RJQ(7))
01900 1,(RPOS(1,1),RN(3921)),(ST2,ST(2)),(IBL,LY(1)),(RJM,RJQ(11))
02000 1,(IE,LX(4)),(IP,LX(10)),(IM,LX(9)),(II,LX(6)),(IS,LX(12))
02100 DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
02200 1 ,LST/'NOTE','REST','CLEF','LINE','NUMB',
02300 1 'MISC','KSIG','SLUR','BEAM','STAFF','METER','TRILL','WORD'/
02400 1,DP/8*1/,LX/'A','C','D','E','G','I','J','L','M','P','R',
02500 1 'S','U','X'/
02600 1,LY/' ','A','B','D','E','F','T'/
02700
02800 TOP2=-999
02900 RXGP=0
03000 I1=0
03100 C RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
03200 2 CALL DPYSET(1,ST,4000)
03300 CALL TYPLOC(-200,-511)
03400 CALL DPYBRT(5)
03500 RPOS(1,1)=0
03600 PLOTIT=0
03700 RSZ=.845
03800 TOP=-999
03900 BOT=999
04000 JSTF=-1
04100 X22=0
04200 PLT=0
04300 PWDS(1)=1.
04400 EDX=-1
04500 SAVER=7
04600 DO 1402 K=1,8
04700 1402 RSTFAC(K)=1.
04800 REDIT=999.
04900 M=1
05000 ITEM=0
05100 ZERO=-1
05200 WDS(1)=4
05300 C DATA IN DPY ARRAY STARTS AT WD.4!
05400 I=1
05500 1100 SCORE=-1
05600 1000 IREADX=0
05700 KNT=0
05800 CALL DPYOUT(1)
05900 IF(SCORE.OR.REND)GO TO 58
06000 C REND=-1 LAST TIME IN SCORE SECTION
06100 CALL SCMSS
06200 I=ISC
06300 ITEM=ISITEM
06400 ST2=WDS(ITEM+1)
06500 CALL ACCPOG(1)
06600 IF(REND.NE.100)GO TO 553
06700 C FOR ESCAPE FROM 'SCORE' SECTION
06800 GO TO 1100
06900 58 GO=-1
07000 GO TO 5505
07100
07200
07300 11 CALL NOTWRT
07400 57 IF(PLT)GO TO 6120
07500 IF(M.LE.I.AND.GO)CALL DPYOUT(1)
07600 IF(JA.EQ.101)GO TO 5531
07700 ITEM=ITEM+1
07800 IF(GO.GT.0)GO TO 20000
07900 K=ST2
08000 IF(X22.EQ.0)GO TO 20000
08100 CALL BOX(IBOX,RBOX,STFF)
08200 ST2=K
08300 20000 WDS(ITEM+1)=ST2
08400 IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
08500 IF(PLOTIT.EQ.-2)GO TO 2311
08600 C SL=SAVE AFTER RESETTING LENGTH OF PAGE. (SEE I2 IN SCX)
08700 PWDS(ITEM+1)=I
08800 PLT=0
08900 IF(GO.NE.0)GO TO 5531
09000 CALL DPYOUT(1)
09100 GO=-1
09200
09300 5531 IF(IREADX.EQ.-2)GO TO 653
09400 IF(JSTF)GO TO 55
09500 JA=JSTF
09600 JSTF=-1
09700 GO TO 889
09800 C PUT IN A STAFF
09900 55 IF(IREADX.OR.SCORE.EQ.0)GO TO 553
10000 5505 SVST=ST2
10087 C CATCHES TYPO WITH 'C'
10100 K=ITEM+1
10200 IF(X22.EQ.0)GO TO 5503
10300 K=X22
10400 L=RN(MEDIT+1)
10500 IF(L.EQ.16)L=13
10600 IF(L.EQ.18)L=11
10700 IF(L.EQ.30)L=12
10702 IF(L.EQ.11)L=0
10800 C CHANGE CODE NUMS FOR 18 AND 30 ****************
10900 TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
11000 IF(YED.LT.2)GO TO 5500
11100 C YED IS SET AT 426
11200 5502 DO 5501 L=4,YED+2
11300 5501 TYPE 4271,L,RN(MEDIT+L)
11400 GO TO 5500
11500 891 DEL=0
11600 C THIS NOT USED IF DEL=0 AT LN32510 ***********
11700 GO TO 6531
11800
11900 5503 CALL HYDPOG(3)
12000 C TO DELETE VERTICAL LINE (55)
12100 KED=0
12200 5500 IF(DEL)GO TO 891
12300 IF(IREADX)GO TO 653
12400 5504 IF(I1.EQ.IP)GO TO 2311
12500 59 TYPE 56,NAME,K,SVST
12600 JAB=JA
12700 SCORE=-1
12800 ACCEPT 89,INP
12900 DO 1313 LKX=1,14
13000 1313 IF(I1.EQ.LX(LKX))GO TO 2313
13100 LKX=0
13200 2313 LKX=LKX+1
13300 C 'SA'=SAVE; 'S'=SET; 'SB'=SAVE BIG; 'ST'=STAFF;
13400 IF(X22.NE.0)GO TO(87,884,883,883,5313,87,884,87,883,87,59,883
13500 1,15,883,883),LKX
13600 GO TO(87,13,7555,14,5313,120,884,7555,883,7555,311,883,15,883
13700 1,59),LKX
13800 C A C D E G I J L M P R S U(X
13900 C HERE A=ALTER A GROUP, DE=DELETE A GROUP
14000 C 'DP'=DISPLAY OR HIDE WHICH STAVES. D=DOWN N
14100 14 IF(I2-IE)883,13,884
14200 13 GO=1
14300 CALL GRED
14400 IF(JA.EQ.98)GO TO 5533
14500 KNT=0
14600 SCORE=0
14700 GO TO 65
14800 15 DO 3313 LKY=1,7
14900 3313 IF(I2.EQ.LY(LKY))GO TO(312,3121,3121,3121,312,115,884),LKY
15000 C BL A B D E F T
15100 C 'SF'= SAVE AND FIXUP (I HOPE THIS IS TEMPORARY)
15200 115 CALL FIXUP
15300 GO TO 5505
15400 C RESETS FACTORS FOR SAVE AND REDISPLAY
15450 3121 IF(X22.NE.0)GO TO 5505
15500 SAVER=7
15600 CALL SAVIT
15700 GO TO 5505
15800 312 JA=55
15900 RJB=RN(MEDIT+2)
16000 RJC=55.
16100 GO TO 6531
16200 C ABOVE FOR 'S'ET ALIGNMENT
16300 C 'S'=SET ALIGNMENT, 'A'=ALIGN IT. 'M'=MOVER 'C'= COPIER
16400 C 'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE; 'P' #S = PLOT IT
16500 5313 K=-1
16600 DO 882 JA=3,10
16700 882 IF(INP(JA).NE.IBL)GO TO 884
16800 GO TO 883
16900 885 FORMAT(A2,21F)
17000 884 REREAD 885,K,RJB,RJQ
17100 JA=55
17200 IF(I1.EQ.II)JA=22
17300 IF(I2.EQ.IT)JA=44
17400 IF(I2.NE.'P')GO TO 6531
17500 IF(RJB.GT.5)GO TO 1886
17600 C GO BACK AND RESET ALL
17700 K=RJB
17800 JA=0
17900 C USE '5' FOR STAFF 0.
18000 888 IF(K.EQ.5)K=0
18100 DP(K)=-DP(K)
18200 JA=JA+1
18300 K=RJQ(JA)
18400 IF(K.EQ.0)GO TO 85
18500 C JUMP OUT IF RJQ(JA)=0
18600 GO TO 888
18700 C TO GET BACK ALL LINES TYPE 6+
18800 311 JA=0
18850 ML=0
18900 IF(I2.NE.'X')GO TO 884
19000 1886 DO 2886 K=-3,4
19100 2886 DP(K)=1
19200 IF(I1.NE.IP)GO TO 8851
19300 C PXG OR PXC RESETS 'DP'
19400 C TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
19500 2311 CALL PLTCMD
19600 IF(PLOTIT.EQ.0)GO TO 3005
19700 I1=IP
19800 PLOTIT=-1
19900 GO TO 6531
20000 C 'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
20100
20200 881 IF(I1.GT.0)GO TO 87
20300 C JUMP IF I1 IS NOT A LETTER (K>0=NUM, K<0=LET.)
20310 883 IF(I2.EQ.IS)GO TO 2
20320 C TYPE 'RS' TO RESTART.
20350 IF(IX.EQ.I.AND.I1.EQ.'C')GO TO 72
20400 CALL EDIT(JJA,RJJB)
20500 GO TO 6531
20600 89 FORMAT(72A1)
20700 C TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
20800
20900 87 REREAD 1,JA,RJB,RJQ
21000 IF(K)JA=55
21100 C ED 47 -1 = 55 47 -1, ETC.
21200 IF(JA.EQ.101)GO TO 11
21300 IF(JA.GT.0)SAVER=SAVER-1
21400 IF(SAVER.AND.X22.EQ.0)CALL SAVIT
21500 C SAVES EVERY 7TH TIME AROUND
21510 IF(JA.EQ.14.OR.JA.EQ.16.OR.JA.EQ.144)GO TO 88
21600 GO TO 6531
21650 188 RJB=0
21700 88 RSTJC=RSTFAC(JC+4)
21710 SET4=RJB
21720 C SET4 IS NEG. FOR AUTOMATIC STAFF 4 SETUP.
21800 IF(JA.NE.14)GO TO 889
21900 C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
21950 SAVER=-1
22000 DO 1889 K=1,I
22100 J=PWDS(K)
22200 IF(RN(J+1).NE.10)GO TO 1889
22300 IF(RN(J+3).EQ.RJC)GO TO 889
22400 1889 CONTINUE
22500 C DIDN'T FIND THIS STAFF
22600 JSTF=JA
22700 JA=10
22800 GO TO 60
22900 889 SCORE=0
23000 ISC=I
23100 ISITEM=ITEM
23200 C RETAINS ORIGINS OF SCORE SQUENCE
23300 CC DO 9532 K=1,8
23400 DO 9532 L=3001,3800
23500 9532 RN(L)=0
23550 C CLEARS R( , ) ARRAY
23600 REND=0
23700 RSTF=RJC
23800 R(1,1)=JA
23900 R(2,1)=RJB
24000 R(3,1)=RJD
24100 R(4,1)=RJE
24200 R(5,1)=RJF
24300 KNT=0
24400 9533 CALL SCMSS
24500 IREADX=-1
24600 IF(REND)GO TO 653
24700 553 IF(SCORE)GO TO 6531
24800 65 GO=1
24900 C SO DPYOUT COMES ONLY ONE PER LINE.
25000 653 KNT=KNT+1
25100 C NUM OF ITEMS IN LIST
25200 RJK=0
25300 RJQJ=0
25400 RJI=0
25500 JA=R(1,KNT)
25600 RJB=R(2,KNT)
25700 IF(JA.NE.100)GO TO 550
25800 IF(REND.NE.1.)GO TO 1000
25900 C =1 GOES BACK FOR MORE
26000 KNT=0
26100 IF(RJB.LT.0)GO TO 188
26200 C WILL READ ANOTHER STAFF
26300 GO TO 1100
26400 C 100 STOPS READER.
26500 550 DO 7531 K=1,6
26600 7531 RJQ(K)=R(K+2,KNT)
26610 IF(RJG.EQ.1.9)RJQJ=1
26620 C FOR GRACE NOTE SLASH
26650 CC RJI=AMOD(RJC,1.)
26660 IF(JA.EQ.9)GO TO 16
26700 IF(JA.NE.999)GO TO 6531
26800 C 999 MEANS P9 AND P10 ARE USED WITH BEAMS
26900 JA=9
27000 RJQ(8)=R(3,KNT)
27100 RJI=R(2,KNT)
27200 RJB=RJJB
27300 RJC=RJJ(1)
27310 16 RJK=-1
27400 6531 M=1
27500 EDX=-1
27600 IF(JA.EQ.222)GO TO 72
27700 IF(JA.EQ.2222)GO TO 73
27800 DO 5532 K=1,10
27900 5532 JQ(K)=RJQ(K)
28000 IF(JA.NE.99.AND.JA.NE.98)GO TO 7542
28100 CALL DELETE
28200 IF(JA.EQ.99)GO TO 425
28300 5533 X22=0
28400 GO=-1
28500 CALL DPYNEW
28600 GO TO 55
28700
28800 590 IF(PLOTIT.EQ.-1)GO TO 121
28900 I1=0
29000 GO TO 243
29100 C GOES TO PLOTTER
29200 7542 IF(I1.EQ.'P')GO TO 590
29300 C X22= ITEM# WHEN EDITING OR DELETING.
29400 IF(X22.NE.0)GO TO 5511
29500 IF(JA.GT.0)GO TO 155
29600 IF(RJB.NE.0)GO TO 6221
29700 C FOR UP, DOWN, LEFT, RIGHT
29800 GO TO 5505
29900 C GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
30000 155 IF(JA.EQ.24)GO TO 24
30100 IF(JA.EQ.22)GO TO 42
30200 IF(JA.EQ.44)GO TO 44
30300 IF(JA.EQ.55)GO TO 554
30400 IF(JA.EQ.333)GO TO 6333
30500 IF(IABS(JC).GT.5.OR.(IABS(JD).GT.50.AND.JA.GT.4.AND.
30600 1 JA.NE.9.AND.JA.NE.10))GO TO 5505
30700 C CATCHES SOME TYPO ERRORS IN P3 AND P4.
30800 C AVOIDS EXIT AFTER TYPO ERROR
30900 IF(JA.EQ.21.OR.JA.EQ.19)GO TO 61
31100 GO TO 60
31110
31115 33 JB=RJB
31116 RJB=RJJ(JB-2)
31117 IF(JB.EQ.2)RJB=RJJB
31120 TYPE 1,JB,RJB
31130 C TYPE 33,N TO SEE FULL CONTENTS OF PARAM. N.
31140 GO TO 5505
31200
31300 24 GO=0
31350 IF(ABS(RJB).GT.99)GO TO 5505
31400 IF(RJB.NE.0)GO TO 241
31500 GO=-1
31600 243 RJB=1.
31700 C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
31800 241 RSZ=.845*RJB
31900 JCEN=RJC*RSZ
32000 KCEN=RJD*RSZ
32100 RJB=0
32200 RJC=0
32300 RJD=0
32400 TOP=-999
32500 BOT=999
32600 85 M=1
32700 I=PWDS(ITEM+1)
32800 ITEM=0
32900 8552 ST2=3
33000 8852 PLT=1
33100 EDX=0
33200 CALL ACCPOG(1)
33300 IF(JA.NE.24)GO=0
33400 GO TO 6120
33500
33600 6333 CALL LISTP(LST)
33700 GO TO 5505
33800
33900 172 CALL JUGGLE
34000 272 CALL DPYNEW
34100 IF(JA.EQ.22)GO TO 424
34200 C FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
34300 IF(ZERO)GO TO 55
34400 X22=ZERO
34500 ZERO=-1
34600 IF(JA.EQ.55)GO TO 554
34700 IF(JA.EQ.44)GO TO 44
34800 IF(KED.NE.0)GO TO 244
34900 GO TO 425
35000
35100 C 55,POS -- SETS UP ALIGNMENT
35200 554 CALL BOX(-1,RJB,STFF)
35300 IF(JD.EQ.0)KED=-1
35400 RITEM=RJD
35500 C FOR 'ED POS., STF., CODE#'
35600 IF(JC.GT.4)KED=-2
35700 RLINE=RJB
35800 RJB=RJC
35900 GO TO 45
36000
36100 C '22,0' EDITS LAST ITEM ENTERED
36200 42 IF(RJB.NE.0)GO TO 242
36300 X22=ITEM
36400 GO TO 429
36500 44 KED=1
36600 RITEM=RJC
36700 C 'ST', STF#, CODE# (IF 0, ALL ITEMS COME UP)
36800 45 REDIT=RJB
36900 C THE STAFF #
37000 JED=1
37100 244 X=ITEM
37200 IF(JED.GT.X)GO TO 444
37300 DO 144 K=JED,X
37400 L=PWDS(K)
37500 IF(KED.EQ.-2)GO TO 654
37600 C -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
37700 IF(RN(L+3).NE.REDIT)GO TO 144
37800 IF(KED)GO TO 654
37900 IF(RITEM.NE.0.AND.RITEM.NE.RN(L+1))GO TO 144
38000 IF(JA.NE.55)GO TO 344
38100 654 IF(ABS(RLINE-RN(L+2)).LT.5.0)GO TO 344
38200 144 CONTINUE
38300 444 REDIT=999.
38400 C NO MORE ON LINE
38500 RJB=0
38600 C SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
38700 GO TO 73
38800 344 JED=K+1
38900 C FOR NEXT TIME AROUND
39000 X22=K
39100 GO TO 429
39200 C CR MOVES ALONG GIVEN LINE, 222 LEAVES THIS MODE
39300
39400 91 CALL ACCPOG(1)
39500 IF(I.EQ.IX)ITEM=ITEM-1
39600 GO TO 142
39700 242 IF(X22.GT.0)GO TO 5511
39800 142 IF(RJB.NE.0)GO TO 424
39900 IF(REDIT.NE.999..AND.JA.GE.0)GO TO 244
40000 X22=X22+1
40100 IF(JA)X22=X22-1+JA
40200 IF(X22.LT.1)X22=1
40300 GO TO 425
40400 424 X22=RJB
40500 425 IF(X22.GT.ITEM)GO TO 73
40600 C LEAVES EDIT MODE.
40700 429 IX=I
40800 MEDIT=PWDS(X22)
40900 J=2
41000 426 Y=RN(MEDIT)+J
41100 CALL LOOP(0,Y,1,I,MEDIT,RN)
41200 JJA=RN(I+1)
41300 YED=Y-2
41400 L=I+2
41500 DO 422 K=1,11
41600 IF(K.GT.YED)GO TO 423
41700 RJJ(K)=RN(L+K)
41800 GO TO 422
41900 423 RJJ(K)=0
42000 422 CONTINUE
42100 RJJB=RN(L)
42200 IF(GO.GT.0)GO TO 4231
42300 C NO BOX WHEN IN GROUP EDIT ROUTINE
42400 IBOX=I
42500 RBOX=RJJ(1)
42600 CALL BOX(IBOX,RBOX,STFF)
42700 4231 ITEM=ITEM+1
42800 ST2=WDS(ITEM)
42900 GO TO 55
43000 427 FORMAT(1XA5/,F4.0,F7.2,F6.2,$)
43100 4271 FORMAT('+ (',I2,')',F7.2,$)
43200
43300 C FOR EDITING
43400 5511 IF(JA.EQ.55)GO TO 420
43500 220 IF(JA.NE.22)GO TO 720
43600 C 'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
43700 KED=0
43800 JED=0
43900 GO TO 72
44000 720 IF(JA.EQ.44)GO TO 420
44010 IF(JA.EQ.33)GO TO 33
44100 IF(JA.GT.13.OR.JA.EQ.1)GO TO 5505
44200 C PARAM NUM TOO HIGH?
44300 C LOOKS FOR NEXT ITEM TO EDIT IF <CR>
44400 4221 IF(X22.EQ.0.OR.RJB.NE.0)GO TO 5517
44500 C BACKS UP WHEN IN EDIT MODE.
44600
44700 IF(JA.GT.0)GO TO 5518
44800 IF(I.EQ.IX)GO TO 91
44900 ZERO=X22+1
45000 C '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
45100 72 IF(X22.EQ.0)GO TO 55
45200 IF(KED.EQ.0)REDIT=999.
45300 320 IF(I.NE.IX)GO TO 172
45400 ITEM=ITEM-1
45500 C TO DELETE AN ITEM
45600 73 X22=0
45700 CALL DPYNEW
45800 IF(REDIT.EQ.999.)GO TO 441
45900 IF(JA.EQ.55)GO TO 554
46000 IF(JA.EQ.44)GO TO 44
46100 441 IF(RJB.EQ.0.OR.RJB.GT.ITEM)GO TO 55
46200 GO TO 424
46300 C DELETION IN EDIT MODE DOES NOT LEAVE MODE.
46400
46500 5517 IF(JA.EQ.0)GO TO 6221
46600 5518 IF(JA.EQ.2)GO TO 7221
46700 IF(JA.GE.22)GO TO 55
46800 RJJ(JA-2)=RJB
46900 RJB=RJJB
47000 GO TO 6222
47100
47200 7555 CALL MOVER
47300 IF(RJC.EQ.99)GO TO 5504
47400 C 99=BACKUP OUT OF MOVER ETC.
47500 8853 IF(JJB)GO TO 57
47600 M=PWDS(JJB)
47700 I=PWDS(ITEM+1)
47800 ITEM=JJB-1
47900 ST2=WDS(JJB)
48000 C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
48100 GO TO 8852
48200
48300 8851 IF(I1.NE.IP)GO TO 85
48400 GO TO 6531
48500
48600 420 REDIT=0
48700 211 IF(RJB.NE.0)GO TO 320
48800 IF(KED.GE.0)RLINE=RJJB
48900 RJB=RLINE
49000 C FOR '55' ALIGNING
49100 7221 RJJB=RJB
49200 6222 IF(JQ(1).EQ.0)GO TO 6221
49300 C ARRAYS NEED 2O LOCATIONS HERE.
49400 C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122 4,13 5,-2 ETC.)
49500 DO 1222 K=1,20,2
49600 L=JQ(K)
49700 IF(L-2)6221,2222,3222
49800 3222 RJJ(L-2)=RJQ(K+1)
49900 GO TO 1222
50000 2222 RJJB=RJQ(K+1)
50100 RJB=RJJB
50200 1222 CONTINUE
50300 C*** LOOP SET TO 10 (20 IN ARRAY!)
50400 6221 DO 5514 K=1,11
50500 RJQ(K)=RJJ(K)
50600 5514 JQ(K)=RJQ(K)
50700 JA=JJA
50800 ITEM=ITEM-1
50900 IF(ITEM)ITEM=0
51000 ST2=WDS(ITEM+1)
51100 I=PWDS(ITEM+1)
51110 CALL DPYNEW
51120
51130 60 IF(DP(JC))GO TO 57
51140 RSTJC=RSTFAC(JC+4)
51150 RD=0
51152 IF(JA.EQ.50)JA=16
51156 C ABOVE SHOULD BE TAKEN OUT AT SOME FUTURE DATE. (12/73)
51160 IF(RJB.LT.1000)GO TO 66
51165 RD=RJB
51190 IF(JA.EQ.8)RJM=RJB/1000.
51270 CALL RNOTE(RJB)
51370 C IF RJB>1000 IT FINDS TRUE RJB THROUGH NOTE NUMB.
51490 66 IF(EDX.EQ.0.OR.I1.EQ.IP)GO TO 5541
51500 RJJB=RJB
51700 JJA=JA
51800 IF(JA.NE.16.OR.RJI.EQ.0)GO TO 160
51900 CC360 RJI=0
52125 RJB=RN(IFIX(PWDS(X22-1))+2)+39.6*RSTJC*RJE
52200 C PUTS 13TH(+) LETTER TIN RIGHT POS. AFTER HORIZ. MOVE.
52390 160 IF(JA.EQ.1.AND.RJH.EQ.0)RJH=999.
52400 C 999=0 FOR STEM EXTENSIONS.
52410 CNT=1
52500 DO 5543 K=1,9
52503 C 10/6/73 ABOVE WAS ,11
52510 RA=RJQ(K)
52520 IF(RA.NE.0)CNT=K
52600 5543 RJJ(K)=RA
52800 C USES ONLY 10 PARAMETERS BEYOND JA, JB
53400 2554 IF(PLT.NE.0)GO TO 5541
53500 IF(JA.EQ.9)CALL HOMER
53600 IF(JA.NE.6)GO TO 1261
53700 IF(JF.NE.0)RJM=-1
53800
53900 1261 IF(RJM.NE.0)CALL HOMER
54000 C IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
54100 C **** FOR '0' EDITS ******
54200 261 RN(I)=CNT
54300 RN(I+1)=JA
54400 I=I+2
54500 RN(I)=RJB
54510 IF(RD.NE.0)RN(I)=RD
54520 C TO SAVE NOTE NUMBS IN P2.
54600 DO 4554 K=1,CNT
54700 4554 RN(I+K)=RJQ(K)
54800 3554 I=CNT+1+I
54900 C WHAT ABOUT EDITS?*******
55000 5541 POS=STFF(JC+4)
55100 JB=RHORZ(RJB)
55200 C LINE IS DIVIDED INTO 200 POINTS.
55300 CENTR=POS
55400 551 IF(JA.EQ.4.OR.JA.EQ.10)GO TO 25
55500 IF(JA.EQ.7)GO TO 81
55600 IF(JA.LE.12.OR.JA.EQ.30)GO TO 11
55700 IF(JA.EQ.18)GO TO 80
55800 IF(JA.NE.88)GO TO 116
55802 IF(RJB.EQ.0)RJB=1
55804 C USE ONLY ONE 88 CHANGE PER STAFF!!!! ********
55900 RSTFAC(JC+4)=RJB
56000 C 88,FAC,STF SETS STAFF SIZE FACTOR(ALSO CAN BE DONE WITH 10)
56100 GO TO 57
56200 116 IF(JA.NE.16.AND.JA.NE.20)GO TO 120
56300 CALL ALPHA
56400 GO TO 57
56500
56600 81 CALL KSIG
56700 GO TO 57
56800
56900 80 CALL METER
57000 GO TO 57
57100
57200 61 CALL HOMER
57300 GO TO 8853
57400
57500 25 CALL ITMSUB
57600 C BAR LINES, BEAMS, STAFF LINES ****
57700 GO TO 57
57800
57900 C TO GET DISPLAY: 'G'; 'GM' ADDS TO DPY;
58000 120 IF(I.NE.1.AND.I2.NE.IM)GO TO 5505
58100 C 'GM'=GET MORE
58200 TYPE 21
58300 ACCEPT FA5,NAME
58400 IF(NAME.EQ.'99')GO TO 5505
58500 IF(NAME.NE.IBL.AND.LOOKD(NAME).EQ.0)GO TO 120
58600 C FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
58700 3005 REWIND 21
58800 C GUARDS AGAINST LOSSAGE!
58900 PLOTIT=-1
58950 IF(I1.NE.'G')PLOTIT=-2
59000 2005 IF(NAME.EQ.IBL)GO TO 2200
59100 CALL IFILE(21,NAME)
59200 C JUMP TO READ BIG FILES
59300 2200 J=ITEM+1
59400 2202 READ(21,END=2207),X,Y,
59500 1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
59510 1 LCNT,(LIST(K),K=1,LCNT)
59600 CC PUT IN NEXT YEAR(12/73)1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
59700 2207 IF(Y.EQ.0)GO TO 2205
59800 ITEM=ITEM+X
59900 IF(I2.EQ.IM)GO TO 2203
60000 I=Y
60100 READ(21,END=8851),RSTFAC,STFF
60110 IF(I1.EQ.IP)GO TO 6531
60200 READ(21,END=8851),ST2,(ST(K),K=1,ST2+2),(WDS(K),K=1,ITEM+1)
60300 CALL DPYNEW
60400 GO TO 5505
60500 2205 TYPE 2206
60600 CALL EXIT
60700 2206 FORMAT(' **** UNPACK IT! ****')
60800
60900 2203 RA=I-1
61000 DO 2204 K=J,J+X
61100 2204 PWDS(K)=PWDS(K)+RA
61200 GO TO 85
61300 121 IF(PLOTIT.EQ.0)GO TO 5504
61400 5121 CALL PLTSRT
61500 C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
61600 PLT=-1-JH
61700 C (JH) P8=1 OR 2 FOR 2-PASS PLOTS
61800 M=I
61900 I=I+M-1
62000 IF(RJB.EQ.0)RJB=1.
62100 DIS=RJB*1.24
62200 IF(RJC.EQ.0)RJC=RJB
62300 RHT=RJC*1.2
62400 C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
62500 BOT=-BOT*RHT
62600 IF(TOP2.EQ.-999)GO TO 8121
62700 BOT=BOT+TOP2
62800 GO TO 9121
62900 8121 CALL PLOTS(K)
63000 RXGP=995.-BOT
63100 9121 NOMOVE=RJF+RJG*148.*RJC
63200 C RJF=1 FOR NO MOVE AT END. RJG=# OF STAVES TO MOVE FOR NEW STAFF 0.
63300 IXGP=JD
63400 C (JD) P4=1 FOR XGP OUTPUT
63500 IF(JE.NE.0)GO TO 1122
63600 IF(RJD.EQ.0)GO TO 6121
63700 IF(TOP2.NE.-999)RXGP=RXGP-BOT
63800 C MOVES 0 POINT OVER EACH TIME.
63900 GO TO 1122
64000 6121 CALL PLOT(0,BOT,-3)
64100 C MOVES PLOTTER UP IF P5=0.
64200 1122 X22=IXGP
64300
64400 C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
64500 6120 IF(M.GE.I)GO TO 7120
64600 CNT=RN(M)
64700 C CLEARS INPUT ARRAY, USES ONLY 12 PARAMS.
64800 DO 6220 K=CNT+1,10
64900 JQ(K)=0
65000 6220 RJQ(K)=0
65100 JA=RN(M+1)
65110 M=M+2
65200 RJB=RN(M)
65400 DO 9120 K=1,CNT
65500 RJQ(K)=RN(M+K)
65600 9120 JQ(K)=RJQ(K)
65700 M=CNT+M+1
65800 IF(EDX.LE.0)GO TO 60
65900 GO TO 5505
66000
66100 7120 M=1
66200 IF(EDX)GO TO 71201
66300 IF(PLT.EQ.1)EDX=-1
66400 PLT=0
66500 C RETURNS FOR 'SL'=SAVE LAST
66600 GO TO 5505
66700 71201 X=50*RHT
66800 TOP=TOP*RHT+X
66900 IF(NOMOVE.NE.0)TOP=0
67000 IF(NOMOVE.GT.1)TOP=NOMOVE
67100 IF(IXGP.EQ.0)CALL PLOT(0,TOP,3)
67200 TOP2=TOP
67300 GO TO 2
67400 C TO MOVE 'PLOTTER' FOR XGP OUTPUT
67500 CC7121 CALL PLOT(0,TOP,3)
67600 C MOVES PLOTTER UP
67700 C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
67800 CC TOP2=TOP
67900 CC GO TO 2
68000
68100 56 FORMAT(/1XA5,' TYPE FOR ITEM #',I3,I/)
68200 1 FORMAT(I,24F)
68300 21 FORMAT(' FILE NAME?'/)
68400 END